home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Property Editors / picedit.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  9KB  |  318 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {       Picture Editor Dialog                           }
  6. {                                                       }
  7. {       Copyright (c) 1999 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit PicEdit;
  12.  
  13. interface
  14.  
  15. uses Windows, Classes, Graphics, Forms, Controls, Dialogs, Buttons, DsgnIntf,
  16.   StdCtrls, ExtCtrls, ExtDlgs;
  17.  
  18. type
  19.   TPictureEditorDlg = class(TForm)
  20.     OpenDialog: TOpenPictureDialog;
  21.     SaveDialog: TSavePictureDialog;
  22.     OKButton: TButton;
  23.     CancelButton: TButton;
  24.     HelpButton: TButton;
  25.     GroupBox1: TGroupBox;
  26.     ImagePanel: TPanel;
  27.     Load: TButton;
  28.     Save: TButton;
  29.     Clear: TButton;
  30.     ImagePaintBox: TPaintBox;
  31.     procedure FormCreate(Sender: TObject);
  32.     procedure FormDestroy(Sender: TObject);
  33.     procedure LoadClick(Sender: TObject);
  34.     procedure SaveClick(Sender: TObject);
  35.     procedure ClearClick(Sender: TObject);
  36.     procedure HelpButtonClick(Sender: TObject);
  37.     procedure ImagePaintBoxPaint(Sender: TObject);
  38.   private
  39.     Pic: TPicture;
  40.   end;
  41.  
  42.   TPictureEditor = class(TComponent)
  43.   private
  44.     FGraphicClass: TGraphicClass;
  45.     FPicture: TPicture;
  46.     FPicDlg: TPictureEditorDlg;
  47.     procedure SetPicture(Value: TPicture);
  48.   public
  49.     constructor Create(AOwner: TComponent); override;
  50.     destructor Destroy; override;
  51.     function Execute: Boolean;
  52.     property GraphicClass: TGraphicClass read FGraphicClass write FGraphicClass;
  53.     property Picture: TPicture read FPicture write SetPicture;
  54.   end;
  55.  
  56. { TPictureProperty
  57.   Property editor the TPicture properties (e.g. the Picture property).  Brings
  58.   up a file open dialog allowing loading a picture file. }
  59.  
  60.   TPictureProperty = class(TPropertyEditor)
  61.   public
  62.     procedure Edit; override;
  63.     function GetAttributes: TPropertyAttributes; override;
  64.     function GetValue: string; override;
  65.     procedure SetValue(const Value: string); override;
  66.   end;
  67.  
  68. { TGraphicProperty }
  69.  
  70.   TGraphicProperty = class(TClassProperty)
  71.   public
  72.     procedure Edit; override;
  73.     function GetAttributes: TPropertyAttributes; override;
  74.     function GetValue: string; override;
  75.     procedure SetValue(const Value: string); override;
  76.   end;
  77.  
  78. { TGraphicEditor }
  79.  
  80.   TGraphicEditor = class(TDefaultEditor)
  81.   public
  82.     procedure EditProperty(PropertyEditor: TPropertyEditor;
  83.       var Continue, FreeEditor: Boolean); override;
  84.   end;
  85.  
  86. implementation
  87.  
  88. uses TypInfo, SysUtils, DesignConst, LibHelp;
  89.  
  90. {$R *.DFM}
  91.  
  92. { TPictureEditorDlg }
  93.  
  94. procedure TPictureEditorDlg.FormCreate(Sender: TObject);
  95. begin
  96.   HelpContext := hcDPictureEditor;
  97.   Pic := TPicture.Create;
  98.   Save.Enabled := False;
  99. end;
  100.  
  101. procedure TPictureEditorDlg.FormDestroy(Sender: TObject);
  102. begin
  103.   Pic.Free;
  104. end;
  105.  
  106. procedure TPictureEditorDlg.LoadClick(Sender: TObject);
  107. begin
  108.   OpenDialog.Title := SLoadPictureTitle;
  109.   if OpenDialog.Execute then
  110.   begin
  111.     Pic.LoadFromFile(OpenDialog.Filename);
  112.     ImagePaintBox.Invalidate;
  113.     Save.Enabled := (Pic.Graphic <> nil) and not Pic.Graphic.Empty;
  114.     Clear.Enabled := (Pic.Graphic <> nil) and not Pic.Graphic.Empty;
  115.   end;
  116. end;
  117.  
  118. procedure TPictureEditorDlg.SaveClick(Sender: TObject);
  119. begin
  120.   if Pic.Graphic <> nil then
  121.   begin
  122.     SaveDialog.Title := SSavePictureTitle;
  123.     with SaveDialog do
  124.     begin
  125.       DefaultExt := GraphicExtension(TGraphicClass(Pic.Graphic.ClassType));
  126.       Filter := GraphicFilter(TGraphicClass(Pic.Graphic.ClassType));
  127.       if Execute then Pic.SaveToFile(Filename);
  128.     end;
  129.   end;
  130. end;
  131.  
  132. procedure TPictureEditorDlg.ImagePaintBoxPaint(Sender: TObject);
  133. var
  134.   DrawRect: TRect;
  135.   SNone: string;
  136. begin
  137.   with TPaintBox(Sender) do
  138.   begin
  139.     Canvas.Brush.Color := {Self.}Color;
  140.     DrawRect := ClientRect;//Rect(Left, Top, Left + Width, Top + Height);
  141.     if Pic.Width > 0 then
  142.     begin
  143.       with DrawRect do
  144.         if (Pic.Width > Right - Left) or (Pic.Height > Bottom - Top) then
  145.         begin
  146.           if Pic.Width > Pic.Height then
  147.             Bottom := Top + MulDiv(Pic.Height, Right - Left, Pic.Width)
  148.           else
  149.             Right := Left + MulDiv(Pic.Width, Bottom - Top, Pic.Height);
  150.           Canvas.StretchDraw(DrawRect, Pic.Graphic);
  151.         end
  152.         else
  153.           with DrawRect do
  154.             Canvas.Draw(Left + (Right - Left - Pic.Width) div 2, Top + (Bottom - Top -
  155.               Pic.Height) div 2, Pic.Graphic);
  156.     end
  157.     else
  158.       with DrawRect, Canvas do
  159.       begin
  160.         SNone := srNone;
  161.         TextOut(Left + (Right - Left - TextWidth(SNone)) div 2, Top + (Bottom -
  162.           Top - TextHeight(SNone)) div 2, SNone);
  163.       end;
  164.   end;
  165. end;
  166.  
  167. procedure TPictureEditorDlg.ClearClick(Sender: TObject);
  168. begin
  169.   Pic.Graphic := nil;
  170.   ImagePaintBox.Invalidate;
  171.   Save.Enabled := False;
  172.   Clear.Enabled := False;
  173. end;
  174.  
  175. { TPictureEditor }
  176.  
  177. constructor TPictureEditor.Create(AOwner: TComponent);
  178. begin
  179.   inherited Create(AOwner);
  180.   FPicture := TPicture.Create;
  181.   FPicDlg := TPictureEditorDlg.Create(Self);
  182.   FGraphicClass := TGraphic;
  183. end;
  184.  
  185. destructor TPictureEditor.Destroy;
  186. begin
  187.   FPicture.Free;
  188.   inherited Destroy;
  189. end;
  190.  
  191. function TPictureEditor.Execute: Boolean;
  192. begin
  193.   FPicDlg.Pic.Assign(FPicture);
  194.   with FPicDlg.OpenDialog do
  195.   begin
  196.     Options := [ofHideReadOnly, ofFileMustExist, ofShowHelp];
  197.     DefaultExt := GraphicExtension(GraphicClass);
  198.     Filter := GraphicFilter(GraphicClass);
  199.     HelpContext := hcDLoadPicture;
  200.   end;
  201.   with FPicDlg.SaveDialog do
  202.   begin
  203.     Options := [ofHideReadOnly, ofFileMustExist, ofShowHelp];
  204.     DefaultExt := GraphicExtension(GraphicClass);
  205.     Filter := GraphicFilter(GraphicClass);
  206.     HelpContext := hcDSavePicture;
  207.   end;
  208.   FPicDlg.Save.Enabled := (FPicture.Graphic <> nil) and not FPicture.Graphic.Empty;
  209.   FPicDlg.Clear.Enabled := (FPicture.Graphic <> nil) and not FPicture.Graphic.Empty;
  210.   Result := FPicDlg.ShowModal = mrOK;
  211.   if Result then FPicture.Assign(FPicDlg.Pic);
  212. end;
  213.  
  214. procedure TPictureEditor.SetPicture(Value: TPicture);
  215. begin
  216.   FPicture.Assign(Value);
  217. end;
  218.  
  219. { TPictureProperty }
  220.  
  221. procedure TPictureProperty.Edit;
  222. var
  223.   PictureEditor: TPictureEditor;
  224. begin
  225.   PictureEditor := TPictureEditor.Create(nil);
  226.   try
  227.     PictureEditor.Picture := TPicture(Pointer(GetOrdValue));
  228.     if PictureEditor.Execute then
  229.       SetOrdValue(Longint(PictureEditor.Picture));
  230.   finally
  231.     PictureEditor.Free;
  232.   end;
  233. end;
  234.  
  235. function TPictureProperty.GetAttributes: TPropertyAttributes;
  236. begin
  237.   Result := [paDialog];
  238. end;
  239.  
  240. function TPictureProperty.GetValue: string;
  241. var
  242.   Picture: TPicture;
  243. begin
  244.   Picture := TPicture(GetOrdValue);
  245.   if Picture.Graphic = nil then
  246.     Result := srNone else
  247.     Result := '(' + Picture.Graphic.ClassName + ')';
  248. end;
  249.  
  250. procedure TPictureProperty.SetValue(const Value: string);
  251. begin
  252.   if Value = '' then SetOrdValue(0);
  253. end;
  254.  
  255. { TGraphicProperty }
  256.  
  257. procedure TGraphicProperty.Edit;
  258. var
  259.   PictureEditor: TPictureEditor;
  260. begin
  261.   PictureEditor := TPictureEditor.Create(nil);
  262.   try
  263.     PictureEditor.GraphicClass := TGraphicClass(GetTypeData(GetPropType)^.ClassType);
  264.     PictureEditor.Picture.Graphic := TGraphic(Pointer(GetOrdValue));
  265.     if PictureEditor.Execute then
  266.       if (PictureEditor.Picture.Graphic = nil) or
  267.          (PictureEditor.Picture.Graphic is PictureEditor.GraphicClass) then
  268.         SetOrdValue(LongInt(PictureEditor.Picture.Graphic))
  269.       else
  270.         raise Exception.CreateRes(@SInvalidFormat);
  271.   finally
  272.     PictureEditor.Free;
  273.   end;
  274. end;
  275.  
  276. function TGraphicProperty.GetAttributes: TPropertyAttributes;
  277. begin
  278.   Result := [paDialog];
  279. end;
  280.  
  281. function TGraphicProperty.GetValue: string;
  282. var
  283.   Graphic: TGraphic;
  284. begin
  285.   Graphic := TGraphic(GetOrdValue);
  286.   if (Graphic = nil) or Graphic.Empty then
  287.     Result := srNone else
  288.     Result := '(' + Graphic.ClassName + ')';
  289. end;
  290.  
  291. procedure TGraphicProperty.SetValue(const Value: string);
  292. begin
  293.   if Value = '' then SetOrdValue(0);
  294. end;
  295.  
  296. { TPictureEditor }
  297.  
  298. procedure TGraphicEditor.EditProperty(PropertyEditor: TPropertyEditor;
  299.   var Continue, FreeEditor: Boolean);
  300. var
  301.   PropName: string;
  302. begin
  303.   PropName := PropertyEditor.GetName;
  304.   if (CompareText(PropName, 'PICTURE') = 0) or
  305.     (CompareText(PropName, 'IMAGE') = 0) then
  306.   begin
  307.     PropertyEditor.Edit;
  308.     Continue := False;
  309.   end;
  310. end;
  311.  
  312. procedure TPictureEditorDlg.HelpButtonClick(Sender: TObject);
  313. begin
  314.   Application.HelpContext(HelpContext);
  315. end;
  316.  
  317. end.
  318.